home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvmenu.exe / MENUTICK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-16  |  3.0 KB  |  114 lines
  1. Unit MenuTick;
  2.  
  3. Interface uses Menus;
  4.  
  5.    Function NewCheckItem( Name, Param : TMenuStr; KeyCode, Command :Word;
  6.                           AHelpCtx : Word; Checked : Boolean;
  7.                           Next : PMenuItem ) : PMenuItem;
  8.  
  9.    Function CheckMenuItem( AMenu : PMenu; var Command : Word ) : Boolean;
  10.    Function ClearMenuItem( AMenu : PMenu; var Command : Word ) : Boolean;
  11.    Function MenuItemIsChecked( AMenu : PMenu; var Command : Word ) : Boolean;
  12.    Function ToggleMenuItem( AMenu : PMenu; var Command : Word ) : Boolean;
  13.  
  14. const
  15.    CheckMark : Char = #251;
  16.    ClearMark : Char = ' ';
  17.  
  18. Implementation
  19.  
  20. Function NewCheckItem( Name, Param : TMenuStr; KeyCode, Command :Word;
  21.                        AHelpCtx : Word; Checked : Boolean;
  22.                        Next : PMenuItem ) : PMenuItem;
  23. begin
  24.    if Name <> '' then
  25.    begin
  26.       Name := ' ' + Name;
  27.       if Checked then
  28.          Name := CheckMark + Name else
  29.          Name := ClearMark + Name;
  30.    end;
  31.    NewCheckItem := NewItem( Name, Param, KeyCode, Command, AHelpCtx, Next );
  32. end;
  33.  
  34. Function FindMenuItem( AMenu : PMenu; Command : Word ) : PMenuItem;
  35. var
  36.    P, Q : PMenuItem;
  37. begin
  38.    P := AMenu^.Items;
  39.    while P <> Nil do
  40.    begin
  41.       if ( P^.Command = 0 ) and ( P^.Name <> Nil ) then
  42.       begin
  43.          Q := FindMenuItem( P^.SubMenu, Command );
  44.          if Q <> Nil then
  45.          begin
  46.             FindMenuItem := Q;
  47.             Exit;
  48.          end;
  49.       end else
  50.       begin
  51.          if ( P^.Command = Command ) and not P^.Disabled then
  52.          begin
  53.             FindMenuItem := P;
  54.             Exit;
  55.          end;
  56.       end;
  57.       P := P^.Next;
  58.    end;
  59.    FindMenuItem := Nil;
  60. end;
  61.  
  62. Function CheckMenuItem( AMenu : PMenu; var Command : Word ) : Boolean;
  63. var
  64.    MenuItem : PMenuItem;
  65. begin
  66.    CheckMenuItem := False;
  67.    MenuItem := FindMenuItem( AMenu, Command );
  68.    if MenuItem <> Nil then
  69.    begin
  70.      if MenuItem^.Name^[1] = ClearMark then
  71.      begin
  72.         MenuItem^.Name^[1] := CheckMark;
  73.         CheckMenuItem := True;
  74.       end;
  75.    end else Command := 0;
  76. end;
  77.  
  78. Function ClearMenuItem( AMenu : PMenu; var Command : Word ) : Boolean;
  79. var
  80.    MenuItem : PMenuItem;
  81. begin
  82.    ClearMenuItem := False;
  83.    MenuItem := FindMenuItem( AMenu, Command );
  84.    if MenuItem <> Nil then
  85.    begin
  86.       if MenuItem^.Name^[1] = CheckMark then
  87.       begin
  88.          MenuItem^.Name^[1] := ClearMark;
  89.          ClearMenuItem := True;
  90.       end;
  91.    end else Command := 0;
  92. end;
  93.  
  94. Function MenuItemIsChecked( AMenu : PMenu; var Command : Word ) : Boolean;
  95. var
  96.    MenuItem : PMenuItem;
  97. begin
  98.    MenuItemIsChecked := False;
  99.    MenuItem := FindMenuItem( AMenu, Command );
  100.    if MenuItem <> Nil then
  101.    begin
  102.       if MenuItem^.Name^[1] = CheckMark then
  103.          MenuItemIsChecked := True;
  104.    end else Command := 0;
  105. end;
  106.  
  107. Function ToggleMenuItem( AMenu : PMenu; var Command : Word ) : Boolean;
  108. begin
  109.    if MenuItemIsChecked( AMenu, Command ) then
  110.       ClearMenuItem( AMenu, Command ) else
  111.       if Command <> 0 then CheckMenuItem( AMenu, Command );
  112. end;
  113.  
  114. end.